home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib02.dsk / A.I.M. SYSTEM.bas next >
BASIC Source File  |  2023-02-26  |  23KB  |  406 lines
  1. 10  REM  ************************
  2. 11  REM  *    A.I.M. SYSTEM     *
  3. 12  REM  * BY MICHAEL WEINSTOCK *
  4. 13  REM  * COPYRIGHT  1980  BY: *
  5. 14  REM  *    MICRO-SPARC, INC  *
  6. 15  REM  *    LINCOLN MA 01773  *
  7. 16  REM  ************************
  8. 80  PRINT  CHR$(4);"BLOAD SEARCH,A$0302"
  9. 90  POKE 1013,76: POKE 1014,2: POKE 1015,3
  10. 100  POKE 768,0: POKE 769,0
  11. 110  REM  PLACE TITLE ON SCREEN
  12. 120  TEXT : HOME : GOSUB 340
  13. 130  VTAB 3: HTAB 10: PRINT "M I C R O - S P A R C": VTAB 4: HTAB 14: PRINT "P.O. BOX 325": VTAB 5: HTAB 11: PRINT "LINCOLN, MA   01773"
  14. 140  VTAB 9: HTAB 13: PRINT "P R E S E N T S": VTAB 12: HTAB 8: FLASH : PRINT " ** D A T A  B A S E **": NORMAL : VTAB 15: HTAB 10: PRINT "AUTOMATED INTELLIGENT": HTAB 11: PRINT "INFORMATION SYSTEM": VTAB 20: HTAB 7: PRINT "COPYRIGHT 1980, C.D.S.,INC"
  15. 150  VTAB 22: INVERSE : HTAB 10: PRINT "PRESS RETURN FOR MENU": NORMAL 
  16. 160  WAIT  -16384,128
  17. 170  GOTO 500
  18. 180  REM  ***  SUBROUTINES BELOW  ***
  19. 190  VTAB 23: CALL  -868: PRINT "CORRECT (Y/N) ";G$;: GET Y$: PRINT Y$: RETURN 
  20. 200  PRINT "ENTER ";: INVERSE :CV =  PEEK(37): GOSUB 210:P$(K) = Q$: RETURN 
  21. 210  PRINT T$(K);: NORMAL : PRINT ": ";G$: PRINT V1$; TAB( TV(K) +3);V2$: VTAB (CV +2): HTAB 2: INPUT Q$: VTAB (CV +1): HTAB ( LEN(T$(K)) +9): CALL  -958: PRINT Q$: RETURN 
  22. 220  PRINT D$;"OPEN ";FILE$;",L";RL
  23. 230  PRINT D$;"WRITE";FILE$;",R";RX
  24. 240  RETURN 
  25. 250  PRINT "PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " TO QUIT ";: RETURN 
  26. 260  VTAB 2: HTAB (20 - LEN(AA$)/2): INVERSE : PRINT AA$: NORMAL 
  27. 270  VTAB 4: HTAB 2: PRINT B$: VTAB 4: INVERSE : HTAB (20 - LEN(A1$)/2): PRINT A1$: POKE 34,4: NORMAL : RETURN 
  28. 280  PRINT D$;"OPEN ";FILE$;",L";RL
  29. 290  PRINT D$;"READ";FILE$;",R";RX
  30. 300  RETURN 
  31. 310  HOME : PRINT : FOR K = 1 TO NF: PRINT K;". ";T$(K);" - ";: INVERSE : PRINT P$(K): NORMAL : NEXT K: RETURN 
  32. 320  VTAB 23: HTAB 10: GOSUB 250: PRINT : VTAB 21: PRINT "ENTER LINE # OF INCORRECT DATA: ";G$;: INPUT Z$: IF Z$ = ""  THEN 2160
  33. 330  HOME : VTAB 7: PRINT T$(Z);" - ";: INVERSE : PRINT P$(Z): NORMAL : PRINT : PRINT "ENTER IN CORRECT DATA:";G$;: INPUT P$(Z): RETURN 
  34. 340  VTAB 23: FOR K = 1 TO 39: PRINT "*";: NEXT K: PRINT : VTAB 1: FOR K = 1 TO 39: PRINT "*";: NEXT K: PRINT 
  35. 350  FOR K = 1 TO 22: PRINT "*";: HTAB 39: PRINT "*": NEXT K: RETURN 
  36. 360  HOME : PRINT D$"CATALOG,S"SX;",D"DX
  37. 370  PRINT : PRINT "ENTER FILE NAME: ";G$;: INPUT FILE$: IF  LEN(FILE$) = 0  THEN  CLEAR : GOTO 500
  38. 380  PRINT D$"OPEN";FILE$ +BC$
  39. 390  PRINT D$"READ";FILE$ +BC$
  40. 400  INPUT NF: INPUT RL: DIM T$(2 *NF),TV(NF),P$(NF)
  41. 410  FOR K = 1 TO NF: INPUT T$(K): INPUT TV(K): NEXT K
  42. 420  PRINT D$"CLOSE"FILE$ +BC$
  43. 430  RETURN 
  44. 440  PRINT D$;"OPEN ";FILE$;",L";RL
  45. 450  PRINT D$;"READ";FILE$;",R0"
  46. 460  RETURN 
  47. 470 TX$(LX) = "": REM    NOTHING IN BETWEEN ""
  48. 480  GET T1$: PRINT T1$;: IF T1$ =  CHR$(13)  THEN  RETURN 
  49. 490 TX$(LX) = TX$(LX) +T1$: GOTO 480
  50. 500  REM    ***  SUBROUTINES ABOVE  ***
  51. 510  REM    MENU
  52. 520 V1 = 8: DIM M$(V1):B$ = "                              ": REM    30 SPACES
  53. 530 BC$ =  CHR$(2):D$ =  CHR$(4):G$ =  CHR$(7):H$ =  CHR$(8):V1$ =  CHR$(91):V2$ =  CHR$(93)
  54. 540  TEXT : HOME : GOSUB 340
  55. 550 AA$ = "D A T A  B A S E":A1$ = "M E N U": GOSUB 260: RESTORE 
  56. 560  FOR K = 1 TO V1: READ M$(K): NEXT K
  57. 570  DATA  "INITIALIZE NEW FILE","ENTER DATA","DISPLAY/PRINT DATA","CHANGE/DELETE DATA","FIND DATA"
  58. 580  DATA  "PRINT REPORT","COMPUTE SUBTOTALS","END PROGRAM"
  59. 590  FOR K = 1 TO V1: VTAB (2 *K +4): HTAB 8: PRINT K;". ";M$(K): NEXT K
  60. 600  VTAB 22: HTAB 4: PRINT "ENTER CHOICE (BY NUMBER):";G$;V1$;" ";V2$;H$;H$;: NORMAL : GET Y$: PRINT Y$:Y =  VAL(Y$): IF Y <1  OR Y >V1  THEN 600
  61. 610  VTAB 2 *Y +4: HTAB 8: INVERSE : PRINT Y;". ";M$(Y): NORMAL : FOR KK = 1 TO 400: NEXT KK
  62. 620  IF Y = 8  THEN 8000
  63. 630 SX =  PEEK(768):DX =  PEEK(769): IF SX >0  AND SX <8  AND DX = 1  OR DX = 2  THEN 710
  64. 640  TEXT : CALL  -936: VTAB 6: CALL  -958: PRINT "ENTER SLOT # FOR DATA DISKETTE:";G$;: GET SX$: PRINT SX$:SX =  VAL(SX$)
  65. 650  IF SX <1  OR SX >7  THEN 640
  66. 660  VTAB 8: CALL  -868: PRINT "ENTER DRIVE # FOR DATA DISKETTE:";G$;: GET DX$: PRINT DX$:DX =  VAL(DX$)
  67. 670  IF (DX -1) *(DX -2) < >0  THEN 660
  68. 680  VTAB 10: CALL  -958: PRINT "SLOT # =";SX: PRINT "DRIVE # =";DX: GOSUB 190: IF Y$ = "N"  THEN 640
  69. 690  IF Y$ < >"Y"  THEN 640
  70. 700  POKE 768,SX: POKE 769,DX
  71. 710  ON Y GOTO 1000,2000,3000,4000,5000,6000,7000
  72. 1000  REM    **INITIALIZER SUBROUTINE**
  73. 1010 V = 16: REM  V=NO. OF FIELD TITLES, EVEN NO.
  74. 1020  DIM T$(V),T(2 *V),TV(2 *V)
  75. 1030  FOR K = 1 TO V:T$(K) = "": NEXT K:T$(0) = H$ +H$ +H$ +H$ + LEFT$(B$,4)
  76. 1050  TEXT : CALL  -936: PRINT "ENTER NAME OF FILE: ";G$;: INPUT FILE$
  77. 1060  CALL  -936: INVERSE : HTAB 14: PRINT "INITIALIZER"
  78. 1070  HTAB (20 - LEN(FILE$)/2): PRINT FILE$: POKE 34,3: NORMAL 
  79. 1080  HOME : PRINT "YOU WILL BE ENTERING IN DATA IN AN": PRINT "ORDERED FORMAT CONSISTING OF FIELDS.": PRINT "THE AVAILABLE NUMBER OF FIELDS IS ";V;"."
  80. 1085 N = 0
  81. 1088  VTAB 8
  82. 1090  FOR K = 1 TO V/2: PRINT K;".  ";T$(K);: HTAB (20): PRINT K +V/2".  ";T$(K +V/2): NEXT K: PRINT : PRINT 
  83. 1110 N = N +1
  84. 1120  VTAB 20: CALL  -958: PRINT "ENTER NAME FOR FIELD # ";N;G$: VTAB 23: HTAB 10: GOSUB 250: VTAB 20: HTAB 25: INPUT ":";Z$: IF N = 1  AND Z$ = ""  THEN  CLEAR : GOTO 500
  85. 1130  IF Z$ = ""  THEN 1160
  86. 1140 T(N) = N
  87. 1150 T$(N) = Z$: GOTO 1088
  88. 1160  HOME :N = N -1
  89. 1170  IF  INT(N/2) = N/2  THEN N2% = N/2
  90. 1180  IF  INT(N/2) < >N/2  THEN N2% = N/2 +1
  91. 1190  FOR K = 1 TO N2%
  92. 1200  PRINT K;". ";T$(T(K));: HTAB (21): PRINT K +N2%;". ";T$(T(K +N2%)): NEXT K
  93. 1210  VTAB 22: CALL  -868: PRINT "CORRECT (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ = "N"  THEN 1030
  94. 1220  IF Y$ < >"Y"  THEN 1210
  95. 1230  CALL  -936: VTAB 4: PRINT "ENTER LENGTH VALUES FOR EACH FIELD:"
  96. 1240  FOR K = 1 TO N
  97. 1250  VTAB 6: CALL  -958: PRINT "FOR FIELD # ";K;" ";: INVERSE : PRINT T$(T(K));G$;: NORMAL : INPUT " ";TV(K): NEXT K
  98. 1260  TEXT : HOME : INVERSE : HTAB (20 - LEN(A$)/2): PRINT A$: PRINT : PRINT : POKE 34,3: NORMAL 
  99. 1270 RL = 0: PRINT "#     FLD NAME         FLD LENGTH"
  100. 1280  PRINT "-     --- ----         --- ------"
  101. 1290  FOR K = 1 TO N
  102. 1300  PRINT K;". ";: HTAB 5: INVERSE : PRINT T$(T(K));: NORMAL : HTAB 25: PRINT "  ";TV(K):RL = RL +TV(K) +1: NEXT 
  103. 1310  VTAB 23: CALL  -868: PRINT "CORRECT (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ = "N"  THEN 1230
  104. 1320  IF Y$ < >"Y"  THEN 1310
  105. 1330  PRINT D$"OPEN";FILE$ +BC$;",S"SX;",D"DX
  106. 1340  PRINT D$"WRITE";FILE$ +BC$
  107. 1350  PRINT N: PRINT RL: FOR K = 1 TO N: PRINT T$(T(K)): PRINT TV(K): NEXT K
  108. 1360  PRINT D$"CLOSE";FILE$ +BC$
  109. 1370  PRINT D$"LOCK";FILE$ +BC$
  110. 1380  PRINT D$;"OPEN ";FILE$;",L";RL
  111. 1390  PRINT D$;"WRITE";FILE$;",R0"
  112. 1400  PRINT 0
  113. 1410  PRINT D$;"CLOSE";FILE$
  114. 1420  CLEAR : GOTO 500
  115. 2000  REM    ***DATA ENTRY SUBROUTINE***
  116. 2010 A1$ = "DATA ENTRY ROUTINE"
  117. 2020  TEXT : HOME : GOSUB 260: HOME : GOSUB 360:RX = 0: GOSUB 280
  118. 2030  INPUT REC:REC = REC +1
  119. 2040  PRINT D$;"CLOSE";FILE$
  120. 2050  HOME : PRINT : PRINT "THIS WILL BE RECORD # ";REC
  121. 2060  VTAB 23: PRINT "RETURN ON ";: INVERSE : PRINT T$(1);: NORMAL : PRINT " TO QUIT": VTAB 8
  122. 2070  FOR K = 1 TO NF
  123. 2080  GOSUB 200
  124. 2090  IF  LEN(P$(1)) = 0  THEN 2200
  125. 2100  IF  LEN(P$(K)) < = TV(K)  THEN 2120
  126. 2110  PRINT "ENTRY TOO LONG";G$;G$: FOR KK = 1 TO 750: NEXT KK: VTAB (CV +1): HTAB 1: CALL  -958: GOTO 2080
  127. 2120  NEXT K
  128. 2130  GOSUB 190
  129. 2140  IF Y$ = "N"  THEN 2250
  130. 2150  IF Y$ < >"Y"  THEN 2130
  131. 2160 RX = REC: GOSUB 220
  132. 2170  FOR KK = 1 TO NF: PRINT P$(KK): NEXT KK
  133. 2180  PRINT D$;"CLOSE";FILE$
  134. 2190 REC = REC +1: GOTO 2050
  135. 2200 REC = REC -1:RX = 0
  136. 2210  GOSUB 220
  137. 2220  PRINT REC
  138. 2230  PRINT D$;"CLOSE";FILE$
  139. 2240  CLEAR : GOTO 500
  140. 2250  GOSUB 310: PRINT NF +1;". *ABORT*"
  141. 2260  VTAB 23: HTAB 10: GOSUB 250: PRINT : VTAB 21: PRINT "ENTER LINE # OF INCORRECT DATA: ";G$;: INPUT Z$:Z =  VAL(Z$)
  142. 2270  IF Z$ = ""  THEN 2160
  143. 2280  IF Z = NF +1  THEN 2050
  144. 2290  IF Z <1  OR Z >NF  THEN 2250
  145. 2300  GOSUB 330: GOTO 2250
  146. 3000  REM    ***DISPLAY/PRINT DATA***
  147. 3010 A1$ = "DISPLAY/PRINT DATA"
  148. 3020  TEXT : HOME : GOSUB 260: HOME : GOSUB 360:RX = 0: GOSUB 280
  149. 3030  INPUT REC
  150. 3040  PRINT D$;"CLOSE";FILE$
  151. 3050  HOME : VTAB 6: PRINT "ENTER IN PRINTER INFORMATION.": PRINT : PRINT "DO YOU HAVE A PRINTER (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ = "N"  THEN SLOT = 0: GOTO 3140
  152. 3060  IF Y$ < >"Y"  THEN 3050
  153. 3070  VTAB 10: CALL  -868: PRINT "ENTER IN SLOT # ";G$;: GET SL$: PRINT SL$:SLOT =  VAL(SL$)
  154. 3080  IF Y$ =  CHR$(27)  OR Y$ =  CHR$(32)  THEN  CLEAR : GOTO 500
  155. 3090  IF SLOT <1  OR SLOT >7  THEN  PRINT G$;G$: GOTO 3070
  156. 3100  PRINT : PRINT "PLEASE TURN ON PRINTER.": PRINT "PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT "WHEN READY. ";G$;: INPUT Y$
  157. 3110  PRINT D$"PR#";SLOT
  158. 3120  PRINT 
  159. 3130  PRINT D$"PR#0"
  160. 3140  HOME : VTAB 22: HTAB 10: GOSUB 250: VTAB 7: PRINT 
  161. 3150  PRINT "VIEW(V) OR PRINT(P) DATA  ";G$;: GET VP$: PRINT VP$: IF VP$ =  CHR$(13)  THEN  CLEAR : GOTO 500
  162. 3160  PRINT : CALL  -958: PRINT "ENTER RECORD # TO START WITH ";G$;: INPUT START$:RX =  VAL(START$)
  163. 3170  IF RX >REC  THEN  PRINT "ONLY ";REC;" RECORDS ON FILE!";G$;G$: GOTO 3160
  164. 3180  IF RX <1  THEN RX = 1
  165. 3190  GOSUB 280
  166. 3200  FOR K = 1 TO NF: INPUT P$(K): NEXT K
  167. 3210  IF VP$ = "P"  THEN  PRINT D$"PR#";SLOT: PRINT : PRINT "RECORD # ";RX
  168. 3220  GOSUB 310
  169. 3230  PRINT D$"PR#0"
  170. 3240  PRINT D$;"CLOSE";FILE$
  171. 3250  VTAB 21: INVERSE : PRINT "-->";: NORMAL : PRINT " = NEXT   ";: INVERSE : PRINT "<--";: NORMAL : PRINT " = LAST"; TAB( 31);"RECORD #": VTAB 22: PRINT "PRESS ";: INVERSE : PRINT "ESC";: NORMAL : PRINT " FOR RECORD # "; TAB( 30);RX;" OF ";REC
  172. 3260  GOSUB 250: PRINT G$;: CALL  -868: GET Y$: PRINT Y$: IF Y$ =  CHR$(3)  THEN  END 
  173. 3270  IF Y$ =  CHR$(27)  THEN  VTAB 23: CALL  -868: PRINT "ENTER RECORD NUMBER ";G$;: INPUT RX: GOTO 3170
  174. 3280  IF Y$ =  CHR$(8)  THEN RX = RX -2: GOTO 3320
  175. 3290  IF Y$ =  CHR$(13)  THEN 3140
  176. 3300  IF Y$ =  CHR$(21)  OR Y$ =  CHR$(32)  THEN 3320
  177. 3310  GOTO 3250: REM  *****
  178. 3320 RX = RX +1: GOTO 3170
  179. 4000  REM   ***CHANGE/DELETE DATA***
  180. 4010 A1$ = "CHANGE/DELETE DATA"
  181. 4020  TEXT : HOME : GOSUB 260: HOME : GOSUB 360:RX = 0: GOSUB 280
  182. 4030  INPUT REC
  183. 4040  PRINT D$;"CLOSE";FILE$
  184. 4050  HOME : VTAB 23: HTAB 10: GOSUB 250: VTAB 5: PRINT : PRINT "ENTER RECORD # TO CHANGE/DELETE ";G$;: INPUT RD$
  185. 4060  IF  LEN(RD$) = 0  THEN  CLEAR : GOTO 500
  186. 4070 RD =  INT( VAL(RD$)): IF RD < = 0  THEN 4050
  187. 4080  IF RD < = REC  THEN 4100
  188. 4090  PRINT : PRINT "ONLY ";REC;" RECORDS ON FILE!": PRINT : PRINT "PRESS RETURN TO CONTINUE.";G$;G$;: INPUT Y$: GOTO 4050
  189. 4100 RX = RD: IF RX < = 0  THEN RX = 0
  190. 4110  GOSUB 280: FOR K = 1 TO NF: INPUT P$(K): NEXT K
  191. 4120  PRINT D$;"CLOSE";FILE$
  192. 4130  GOSUB 310
  193. 4140  VTAB 22: CALL  -868: PRINT "CHANGE/DELETE RECORD # ";RD;" (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ = "N"  THEN 4050
  194. 4150  IF Y$ < >"Y"  THEN 4140
  195. 4160  VTAB 22: CALL  -868: PRINT "CHANGE (C), DELETE (D), OR ABORT (CR) ";G$;: GET Y$: PRINT Y$
  196. 4170  IF Y$ =  CHR$(13)  THEN 4050
  197. 4180  IF Y$ = "C"  THEN 4320
  198. 4190  IF Y$ < >"D"  THEN 4160
  199. 4200  VTAB 22: CALL  -868: PRINT "VERIFY DELETION (YES/NO): ";G$;: INPUT Y$: IF Y$ < >"YES"  THEN 4050
  200. 4210  IF RD < >REC  THEN 4250
  201. 4220 RX = 0:REC = REC -1: GOSUB 230: PRINT REC
  202. 4230  PRINT D$;"CLOSE";FILE$
  203. 4240  GOTO 4050
  204. 4250 RX = REC: GOSUB 280: FOR K = 1 TO NF: INPUT P$(K): NEXT K
  205. 4260  PRINT D$;"CLOSE";FILE$
  206. 4270 RX = RD: GOSUB 220: FOR K = 1 TO NF: PRINT P$(K): NEXT K
  207. 4280  PRINT D$;"CLOSE";FILE$
  208. 4290 REC = REC -1:RX = 0: GOSUB 220: PRINT REC
  209. 4300  PRINT D$;"CLOSE";FILE$
  210. 4310  GOTO 4050
  211. 4320  REM  ***CHANGE ROUTINE***
  212. 4330  VTAB 23: HTAB 10: GOSUB 250: PRINT : VTAB 22: CALL  -868: PRINT "ENTER FIELD # TO CHANGE: ";G$;: INPUT Y$:Y =  VAL(Y$): IF Y = 0  THEN 4390
  213. 4340  IF  INT(Y) <1  OR  INT(Y) >NF  THEN 4330
  214. 4350  VTAB 22: CALL  -868: PRINT "ENTER: ";: INVERSE : PRINT G$;T$(Y);: NORMAL : INPUT P$(Y)
  215. 4360  IF  LEN(P$(Y)) < = TV(Y)  THEN 4380
  216. 4370  VTAB 23: CALL  -868: HTAB 10: PRINT "ENTRY TOO LONG!";G$;G$: FOR KK = 1 TO 500: NEXT KK: VTAB 23: HTAB 10: GOSUB 250: PRINT : GOTO 4350
  217. 4380  GOSUB 310: GOTO 4330
  218. 4390 RX = RD: GOSUB 220: FOR K = 1 TO NF: PRINT P$(K): NEXT K
  219. 4400  PRINT D$;"CLOSE";FILE$
  220. 4410  GOTO 4050
  221. 5000  REM  **FIND MODULE**
  222. 5010 A1$ = "FIND INFORMATION":B1$ = "SEARCH"
  223. 5020  TEXT : HOME : GOSUB 260: HOME : GOSUB 360:RX = 0: GOSUB 280
  224. 5030  INPUT REC
  225. 5040  PRINT D$;"CLOSE ";FILE$
  226. 5050  DIM SP$(NF),SERFLD(NF):N = 0
  227. 5055 NQ = 0
  228. 5060  HOME : PRINT : PRINT "THE FOLLOWING LINES ARE AVAILABLE FOR       THE ";B1$;":": PRINT : FOR K = 1 TO NF  STEP 2: PRINT K;". ";T$(K); TAB( 20);K +1;". ";T$(K +1): NEXT K
  229. 5070  FOR K = 1 TO NF: VTAB 20: HTAB 1: CALL  -958: VTAB 24: HTAB 10: GOSUB 250
  230. 5075 NQ = NQ +1
  231. 5080  VTAB 20: HTAB 1: CALL  -868: PRINT "ENTER CHOICE FOR SEARCH FIELD # ";K;G$;: INPUT ": ";SERFLD$: IF SERFLD$ = ""  AND K = 1  THEN  CLEAR : GOTO 500
  232. 5090  IF SERFLD$ = ""  THEN NQ = NQ:K = NF: GOTO 5130
  233. 5100 SERFLD(K) =  VAL(SERFLD$): IF SERFLD(K) <1  OR SERFLD(K) >NF  THEN 5080
  234. 5110  VTAB 22: HTAB 1: CALL  -868: PRINT "ENTER SEARCH PARAMETER ";G$;: INPUT ":";SP$(K):SP =  LEN(SP$(K))
  235. 5120  IF SP >TV(SERFLD(K))  THEN  VTAB 22: HTAB 1: CALL  -868: INVERSE : PRINT "SEARCH PARAMETER TOO LONG !";: NORMAL : FOR II = 1 TO 750: NEXT II: GOTO 5110
  236. 5130  NEXT K: FOR II = 1 TO 300: NEXT II
  237. 5140  HOME : FOR K = 1 TO NQ: VTAB (2 *K +6): HTAB 1: PRINT "SEARCH ";T$(SERFLD(K));" FOR ";SP$(K);: IF K <NQ  THEN  HTAB ( PEEK(36) +2): PRINT "AND";
  238. 5150  NEXT K: PRINT 
  239. 5160  GOSUB 190: IF Y$ = "N"  THEN 5060
  240. 5170  IF Y$ < >"Y"  THEN 5160
  241. 5180  PRINT D$;"OPEN ";FILE$;",L";RL
  242. 5190  FOR K1 = 1 TO REC
  243. 5200 SRFL = 0
  244. 5210  PRINT D$;"READ ";FILE$;",R";K1
  245. 5220  FOR K = 1 TO NF: INPUT P$(K): NEXT K
  246. 5230  FOR K = 1 TO NQ
  247. 5240  & P$(SERFLD(K)),SP$(K)
  248. 5250  IF  PEEK(26) = 0  THEN K = NQ:SRFL = 1
  249. 5260  NEXT K: IF SRFL = 1  THEN 5410
  250. 5270  PRINT D$;"CLOSE ";FILE$
  251. 5280 N = N +1: HOME : GOSUB 310
  252. 5290  VTAB 21: HTAB 1: CALL  -868: INVERSE : PRINT "-->";: NORMAL : PRINT " = TO CONTINUE";: HTAB 31: PRINT "RECORD #";: VTAB 22: HTAB 1: CALL  -868: INVERSE : PRINT "'P'";: NORMAL : PRINT " = TO PRINT";: HTAB 31: PRINT K1;" OF ";REC;
  253. 5300  VTAB 23: HTAB 1: CALL  -868: INVERSE : PRINT "ESC";: NORMAL : PRINT " = TO QUIT";: GET Z$: PRINT Z$;: IF Z$ < >"P"  AND Z$ < > CHR$(21)  AND Z$ < > CHR$(27)  THEN 5300
  254. 5310  IF Z$ =  CHR$(21)  THEN 5400
  255. 5320  IF Z$ =  CHR$(27)  THEN K1 = REC: GOTO 5410
  256. 5330  HOME : PRINT : PRINT "ENTER IN PRINTER SLOT #";G$;: INPUT SLOT
  257. 5340  PRINT : PRINT "TURN ON PRINTER"
  258. 5350  VTAB 23: HTAB 5: INVERSE : PRINT "PRESS ANY KEY TO CONTINUE";: NORMAL : GET Z$: PRINT Z$
  259. 5360  PRINT D$;"PR#";SLOT
  260. 5370  PRINT : PRINT "RECORD # ";K1: GOSUB 310
  261. 5380  PRINT D$;"PR#0"
  262. 5390  GOTO 5290
  263. 5400  PRINT D$;"OPEN ";FILE$;",L";RL
  264. 5410  NEXT K1
  265. 5420  PRINT D$;"CLOSE ";FILE$
  266. 5430  HOME : PRINT : PRINT "SEARCH COMPLETE": PRINT : PRINT N;" RECORDS FOUND": VTAB 23: HTAB 10: GOSUB 250: GET Z$: PRINT Z$: CLEAR : GOTO 500
  267. 6000  REM  ***PRINT MAIL-LABELS***
  268. 6010 A1$ = "PRINT REPORT":B1$ = "REPORT"
  269. 6020  TEXT : HOME : GOSUB 260: HOME : GOSUB 360:RX = 0: GOSUB 280
  270. 6030  INPUT REC
  271. 6040  PRINT D$;"CLOSE";FILE$
  272. 6050 T$(NF +1) = H$ +H$ +H$ +H$ +B$: DIM TX$(2 *NF),TW(2 *NF): FOR K = 1 TO NF:TX$(K) =  CHR$(13): NEXT K
  273. 6060  HOME :L = 0: PRINT : PRINT "THE FOLLOWING LINES ARE AVAILABLE FOR   THE ";B1$;":": PRINT : FOR K = 1 TO NF  STEP 2: PRINT K;". ";T$(K); TAB( 20);K +1;". ";T$(K +1): NEXT K
  274. 6070 L = L +1
  275. 6080  VTAB 23: HTAB 10: GOSUB 250: PRINT : VTAB 20: CALL  -868: PRINT "ENTER FIELD # FOR ";B1$;" LINE ";L;G$;: INPUT TV$: IF L = 1  AND  LEN(TV$) = 0  THEN  CLEAR : GOTO 500
  276. 6090  IF  LEN(TV$) = 0  THEN 6130
  277. 6100  IF TV$ =  CHR$(21)  OR TV$ =  CHR$(32)  THEN  CLEAR : GOTO 500
  278. 6110 TV =  INT( VAL(TV$)): IF TV <1  OR TV >NF  THEN 6080
  279. 6120 TW(L) = TV: GOTO 6070
  280. 6130  HOME :LINES = L -1: PRINT : PRINT "YOUR ";B1$;" WILL CONSIST OF:": PRINT 
  281. 6140  FOR K = 1 TO LINES: HTAB 10: PRINT K;". ";T$(TW(K)): NEXT K: PRINT 
  282. 6150  VTAB 22: PRINT "IS THIS CORRECT (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ = "N"  THEN 6060
  283. 6160  IF Y$ =  CHR$(21)  OR Y$ =  CHR$(32)  THEN  CLEAR : GOTO 500
  284. 6170  IF Y$ < >"Y"  THEN 6150
  285. 6180  VTAB 23: CALL  -868: PRINT "JOIN TOGETHER TWO LINES OR MORE (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ < >"Y"  THEN 6300
  286. 6190  FOR K = 1 TO NF:TX$(K) =  CHR$(13): NEXT K
  287. 6200  VTAB 21: CALL  -958: PRINT "TO   ENTRY #": VTAB 23: HTAB 10: GOSUB 250: PRINT 
  288. 6210  VTAB 20: PRINT "JOIN ENTRY # ";G$;: CALL  -868: INPUT LX$: IF  LEN(LX$) = 0  THEN 6300
  289. 6220  REM 
  290. 6230  VTAB 23: CALL  -958:LX =  VAL(LX$): IF LX <1  OR LX >LINES -1  THEN  PRINT "INVALID!";G$;G$: GOTO 6200
  291. 6240  VTAB 21: HTAB 13: PRINT LX +1
  292. 6250  PRINT "ENTER CONJUNCTION ";: INVERSE : PRINT "(SPACE , ; : / & .)";G$;: NORMAL : CALL  -868:TX$(LX) = "": REM  NOTHING IN BETWEEN ""
  293. 6260  GET T1$: PRINT T1$;: IF T1$ =  CHR$(13)  THEN 6280
  294. 6270 TX$(LX) = TX$(LX) +T1$: GOTO 6260
  295. 6280  VTAB 23: CALL  -868: PRINT T$(TW(LX));TX$(LX);T$(TW(LX +1)): FOR K = 1 TO 1000: NEXT K
  296. 6290  GOTO 6200
  297. 6300  HOME : PRINT : PRINT "THE ";B1$;" WILL LOOK LIKE THIS:": PRINT 
  298. 6310  FOR K = 1 TO LINES: PRINT T$(TW(K));TX$(K);: NEXT K
  299. 6320  VTAB 22: PRINT "CORRECT (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ = "N"  THEN 6060
  300. 6330  IF Y$ < >"Y"  THEN 6320
  301. 6331 SRFL = 0: HOME : PRINT : PRINT "DO YOU WANT A SEARCH IN A SPECIFIC      FIELD ?": GOSUB 190: IF Y$ = "N"  THEN 6340
  302. 6332  IF Y$ < >"Y"  THEN 6331
  303. 6333 SRFL = 1: HOME : PRINT : PRINT "THE FOLLOWING LINES ARE AVAILABLE FOR   THE SEARCH:": PRINT : FOR K = 1 TO NF  STEP 2: PRINT K;". ";T$(K); TAB( 20);K +1;". ";T$(K +1): NEXT K
  304. 6334  VTAB 24: HTAB 5: GOSUB 250
  305. 6335  VTAB 20: HTAB 1: CALL  -868: PRINT "ENTER CHOICE FOR SEARCH FIELD ";G$;: INPUT ":";SERFLD$: IF SERFLD$ = ""  THEN SRFL = 0: GOTO 6340
  306. 6336 SERFLD =  VAL(SERFLD$): IF SERFLD <1  OR SERFLD >NF  THEN 6335
  307. 6337  VTAB 22: HTAB 1: CALL  -868: PRINT "ENTER SEARCH PARAMETER ";G$;: INPUT ":";SP$:SP =  LEN(SP$): IF SP >TV(SERFLD)  THEN  VTAB 22: CALL  -868::: INVERSE : PRINT "SEARCH PARAMETER TOO LONG !";:: NORMAL : FOR II = 1 TO 750: NEXT II: GOTO 6337
  308. 6338  FOR II = 1 TO 300: NEXT II: HOME : PRINT : PRINT "SEARCH ";T$(SERFLD);" FOR ";SP$: GOSUB 190: IF Y$ = "N"  THEN 6331
  309. 6339  IF Y$ < >"Y"  THEN 6338
  310. 6340  HOME : PRINT : PRINT "WANT SORTED ";B1$;" (Y/N)?";G$;: GET Y1$: PRINT Y1$: IF Y1$ < >"Y"  THEN 6520
  311. 6350  DIM SRT$(REC),SO(REC)
  312. 6360  HOME : PRINT : PRINT "THE FOLLOWING LINES ARE AVAILABLE FOR   THE SORT FIELD:": PRINT : FOR K = 1 TO NF  STEP 2: PRINT K;". ";T$(K); TAB( 20);K +1;". ";T$(K +1): NEXT K
  313. 6370  PRINT : PRINT "SORT ON WHICH FIELD (BY NUMBER): ";G$;: INPUT SF$:SF =  VAL(SF$): IF SF <1  OR SF >NF  THEN 6360
  314. 6380  PRINT : PRINT "*** SORT ON ";: INVERSE : PRINT T$(SF): NORMAL 
  315. 6390  PRINT : PRINT "ASCENDING OR DESCENDING SORT (A/D):";G$;: GET S$: PRINT S$:S1 = (S$ = "A")
  316. 6400  PRINT D$;"OPEN";FILE$;",L";RL
  317. 6410  FOR K = 1 TO REC:RX = K: GOSUB 290: IF SF = 1  THEN 6430
  318. 6420  FOR L = 1 TO SF -1: INPUT Z$: NEXT L
  319. 6430  INPUT SRT$(K):SO(K) = K: NEXT K
  320. 6440  PRINT D$;"CLOSE";FILE$
  321. 6450 M = 1
  322. 6460 M = 3 *M +1: IF M <REC  THEN 6460
  323. 6470 M = (M -1)/3: IF M <1  THEN 6510
  324. 6480  FOR J = M +1 TO REC:LL = J -M:SS$ = SRT$(J):S = SO(J)
  325. 6490  IF S1 = (SRT$(LL) >SS$)  THEN SRT$(LL +M) = SRT$(LL):SO(LL +M) = SO(LL):LL = LL -M: IF LL >0  THEN 6490
  326. 6500 SRT$(LL +M) = SS$:SO(LL +M) = S: NEXT J: GOTO 6470
  327. 6510  REM  **SORTED LIST COMPLETE**
  328. 6520  HOME : PRINT : PRINT "ENTER IN PRINTER SLOT #";G$;: INPUT SLOT
  329. 6530  PRINT D$;"PR#";SLOT
  330. 6540  PRINT D$;"PR#0"
  331. 6550  PRINT : PRINT "HOW MANY CARRIAGE RETURNS FROM END OF   ONE ";B1$;" TO NEXT: ";G$;: INPUT CR
  332. 6560  HOME : PRINT : PRINT "ALIGN PAPER.": PRINT : PRINT "PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " WHEN READY.";: GET Y$: PRINT Y$
  333. 6570  PRINT D$;"OPEN";FILE$;",L";RL
  334. 6580  IF Y1$ < >"Y"  THEN 6610
  335. 6590  FOR K1 = 1 TO REC:RX = SO(K1): GOTO 6690
  336. 6600  GOTO 6660
  337. 6610  HOME : VTAB 23: HTAB 10: GOSUB 250: PRINT : VTAB 12: CALL  -868: PRINT "ENTER RECORD # TO START WITH: ";G$;: INPUT RX$:RX =  VAL(RX$): IF  LEN(RX$) = 0  THEN  CLEAR : GOTO 500
  338. 6620  IF RX < = REC  THEN RX = RX -1: HOME : GOTO 6640
  339. 6630  PRINT "ONLY ";REC;" RECORDS ON FILE.";G$;G$: FOR KK = 1 TO 400: NEXT KK: GOTO 6560
  340. 6640 RX = RX +1: IF RX <1  THEN RX = 1
  341. 6650  IF RX < = REC  THEN 6690
  342. 6660  PRINT D$;"CLOSE";FILE$
  343. 6670  PRINT "END OF FILE!";G$;G$
  344. 6680  PRINT : PRINT "PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " WHEN READY";: GET Y$: PRINT Y$: RUN 500
  345. 6690  GOSUB 290: FOR K = 1 TO NF: INPUT P$(K): NEXT K
  346. 6692  IF SRFL = 0  THEN 6700
  347. 6694  & P$(SERFLD),SP$
  348. 6696  IF  PEEK(26) = 0  THEN 6780
  349. 6700  PRINT D$;"PR#";SLOT
  350. 6710 R1 = 0
  351. 6720  FOR K = 1 TO LINES: IF  LEN(P$(TW(K))) = 0  THEN 6740
  352. 6730  PRINT P$(TW(K));TX$(K);: IF  LEN(P$(TW(K))) < >0  AND TX$(K) =  CHR$(13)  THEN R1 = R1 +1
  353. 6740  NEXT K
  354. 6750  IF CR = 0  THEN 6770
  355. 6760  FOR K = 1 TO CR -R1: PRINT : NEXT K
  356. 6770  PRINT D$;"PR#0"
  357. 6780  IF Y1$ < >"Y"  THEN 6640
  358. 6790  NEXT K1: GOTO 6660
  359. 7000  REM   **COMPUTE SUBTOTALS**
  360. 7010 A1$ = "COMPUTE SUBTOTALS":B1$ = "SUBTOTALS"
  361. 7020  TEXT : HOME : GOSUB 260: HOME : GOSUB 360:RX = 0: GOSUB 280
  362. 7030  INPUT REC
  363. 7040  PRINT D$;"CLOSE ";FILE$
  364. 7050  DIM SP$(NF),SERFLD(NF)
  365. 7060  HOME : PRINT : PRINT "THE FOLLOWING LINES ARE AVAILABLE FOR   THE ";B1$;":": PRINT : FOR K = 1 TO NF  STEP 2: PRINT K;". ";T$(K); TAB( 20);K +1;". ";T$(K +1): NEXT K
  366. 7070  VTAB 24: HTAB 10: GOSUB 250
  367. 7080  VTAB 20: HTAB 1: CALL  -868: PRINT "ENTER # FOR FIELD TO SUBTOTAL ";G$;: INPUT ":";ST$: IF ST$ = ""  THEN  CLEAR : GOTO 500
  368. 7090 ST =  VAL(ST$): IF ST <1  OR ST >NF  THEN 7080
  369. 7100  FOR II = 1 TO 300: NEXT II:SRFL = 0
  370. 7110  HOME : PRINT : PRINT "WANT SUBTOTALS ON SPECIFIC RECORDS ?";G$;: GET Y$: PRINT Y$;: IF Y$ = "N"  THEN 7260
  371. 7120  IF Y$ < >"Y"  THEN 7110
  372. 7130 SRFL = 1
  373. 7140  HOME : PRINT : PRINT "THE FOLLOWING FIELDS ARE AVAILABLE FOR  THE SEARCH:": PRINT : FOR K = 1 TO NF  STEP 2: PRINT K;". ";T$(K); TAB( 20);K +1;". ";T$(K +1): NEXT K
  374. 7150  FOR K = 1 TO NF: VTAB 20: HTAB 1: CALL  -958: VTAB 24: HTAB 10: GOSUB 250
  375. 7160  VTAB 20: HTAB 1: CALL  -868: PRINT "ENTER CHOICE FOR SEARCH FIELD # ";K;G$;: INPUT ": ";SERFLD$: IF SERFLD$ = ""  AND K = 1  THEN SRFL = 0: GOTO 7260
  376. 7170  IF SERFLD$ = ""  THEN NP = K -1:K = NF: GOTO 7210
  377. 7180 SERFLD(K) =  VAL(SERFLD$): IF SERFLD(K) <1  OR SERFLD(K) >NF  THEN 7160
  378. 7190  VTAB 22: HTAB 1: CALL  -868: PRINT "ENTER SEARCH PARAMETER ";G$;: INPUT ":";SP$(K):SP =  LEN(SP$(K))
  379. 7200  IF SP >TV(SERFLD(K))  THEN  VTAB 22: HTAB 1: CALL  -868: INVERSE : PRINT "SEARCH PARAMETER TOO LONG !";: NORMAL : FOR II = 1 TO 750: NEXT II: GOTO 7190
  380. 7210  NEXT K: FOR II = 1 TO 300: NEXT II
  381. 7220  HOME : FOR K = 1 TO NP: VTAB (2 *K +6): HTAB 1: PRINT "SEARCH ";T$(SERFLD(K));" FOR ";SP$(K);: IF K <NP  THEN  HTAB ( PEEK(36) +2): PRINT "AND";
  382. 7230  NEXT K: PRINT : GOSUB 190
  383. 7240  IF Y$ = "N"  THEN 7140
  384. 7250  IF Y$ < >"Y"  THEN 7240
  385. 7260  PRINT D$;"OPEN ";FILE$;",L";RL
  386. 7270 FT = 0
  387. 7280  FOR K1 = 1 TO REC
  388. 7290  PRINT D$;"READ ";FILE$;",R";K1
  389. 7300  IF SRFL = 1  THEN 7340
  390. 7310  PRINT D$;"POSITION ";FILE$;",R";(ST -1)
  391. 7320  PRINT D$;"READ ";FILE$
  392. 7330  INPUT P$(ST): GOTO 7400
  393. 7340  FOR K = 1 TO NF: INPUT P$(K): NEXT K
  394. 7350 FL = 0
  395. 7360  FOR K = 1 TO NP
  396. 7370  & P$(SERFLD(K)),SP$(K)
  397. 7380  IF  PEEK(26) = 0  THEN K = NP:FL = 1
  398. 7390  NEXT K: IF FL = 1  THEN 7410
  399. 7400 FT = FT + VAL(P$(ST))
  400. 7410  NEXT K1
  401. 7420  PRINT D$;"CLOSE ";FILE$
  402. 7430  HOME : PRINT : PRINT "THE TOTAL FOR ";T$(ST);" IS ";FT
  403. 7440  VTAB 24: HTAB 10: GOSUB 250: GET Y$: PRINT Y$;: GOTO 7060
  404. 8000  REM   ***END PROGRAM SUBROUTINE***
  405. 8010  FOR K = 1 TO 100: NEXT K: TEXT : HOME : PRINT "DON'T FORGET TO MAKE A BACK-UP": PRINT "OF YOUR DATA.";G$;G$;G$: PRINT : PRINT "HAVE A NICE DAY!"
  406. 8020  END